home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyNewPreferences.p < prev    next >
Encoding:
Text File  |  1994-08-16  |  5.2 KB  |  200 lines  |  [TEXT/PJMM]
  1. unit MyNewPreferences;
  2.  
  3. interface
  4.  
  5.     uses
  6.         MyCollections;
  7.  
  8.     var
  9.         the_prefs_folder_vrn: integer;
  10.         the_prefs_folder_dirID: longInt;
  11.         prefs_fs: FSSPec;
  12.         prefs: collection;
  13.  
  14.     procedure InitPreferences (strhId, folderindex, fileindex: integer; fcreator: OSType);
  15.     procedure FinishPreferences;
  16.     procedure WritePrefsData;
  17.     procedure ReadPrefsData;
  18.     procedure JustReadPrefsData;
  19.     procedure ReadPrefsCollection (c: collection; res_id: integer);
  20.     procedure WritePrefsCollection (c: collection; res_id: integer);
  21.     procedure PutResource (h: handle; typ: ResType; id: integer); { handle remains unchanged, and is detatched }
  22.     procedure ReadPrefsHandle (var h: handle; typ: ResType; id: integer);
  23.     procedure WritePrefsHandle (h: handle; typ: ResType; id: integer);
  24.  
  25. implementation
  26.  
  27.     uses
  28.         Folders, AppleTalk, Aliases, MyFileSystemUtils, MyFDFlags;
  29.  
  30.     const
  31.         prefs_restype = 'PRFN';
  32.         prefs_resid = 128;
  33.         prefs_type = 'pref';
  34.  
  35.     var
  36.         prefs_creator: OSType;
  37.         prefs_mdate: longInt;
  38.  
  39.     procedure ReadPrefsHandle (var h: handle; typ: ResType; id: integer);
  40.         var
  41.             resfile: integer;
  42.     begin
  43.         resfile := HOpenResFile(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, fsRdPerm);
  44.         h := GetResource(typ, id);
  45.         if h <> nil then begin
  46.             DetachResource(h);
  47.         end;
  48.         if resfile <> -1 then
  49.             CloseResFile(resfile);
  50.     end;
  51.  
  52.     procedure ReadPrefsCollection (c: collection; res_id: integer);
  53.         var
  54.             h: handle;
  55.     begin
  56.         ReadPrefsHandle(h, prefs_restype, res_id);
  57.         if h <> nil then begin
  58.             HackUpdateHandleToCollection(h);
  59.             c.SetDataHandle(h);
  60.         end;
  61.     end;
  62.  
  63.     procedure JustReadPrefsData;
  64.     begin
  65.         ReadPrefsCollection(prefs, prefs_resid);
  66.         prefs.safeget := true;
  67.     end;
  68.  
  69.     procedure PutResource (h: handle; typ: ResType; id: integer);
  70.         var
  71.             old: handle;
  72.             xid: integer;
  73.             xtyp: ResType;
  74.             name: str255;
  75.     begin
  76.         name := '';
  77.         old := Get1Resource(typ, id);
  78.         if old <> nil then begin
  79.             GetResInfo(old, xid, xtyp, name);
  80.             RmveResource(old);
  81.             DisposeHandle(old);
  82.         end;
  83.         AddResource(h, typ, id, name);
  84.         WriteResource(h);
  85.         DetachResource(h);
  86.     end;
  87.  
  88.     procedure WritePrefsHandle (h: handle; typ: ResType; id: integer);
  89.         var
  90.             oe: OSErr;
  91.             resfile: integer;
  92.     begin
  93.         oe := HCreate(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, prefs_creator, prefs_type);
  94.         HCreateResFile(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name);
  95.         resfile := HOpenResFile(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, fsRdWrPerm);
  96.         if resfile <> -1 then begin
  97.             PutResource(h, typ, id);
  98.             CloseResFile(resfile);
  99.         end;
  100.     end;
  101.  
  102.     procedure WritePrefsCollection (c: collection; res_id: integer);
  103.         var
  104.             oe: OSErr;
  105.             resfile: integer;
  106.             h: handle;
  107.     begin
  108.         h := c.GetDataHandle;
  109.         WritePrefsHandle(h, prefs_restype, res_id);
  110.     end;
  111.  
  112.     procedure WritePrefsData;
  113.     begin
  114.         WritePrefsCollection(prefs, prefs_resid);
  115.     end;
  116.  
  117.     procedure ReadPrefsData;
  118.         var
  119.             nmoddate: longInt;
  120.     begin
  121.         MyGetModDate(prefs_fs, nmoddate);
  122.         if nmoddate <> prefs_mdate then begin
  123.             prefs_mdate := nmoddate;
  124.             JustReadPrefsData;
  125.         end;
  126.     end;
  127.  
  128.     procedure FixPrefType;
  129.         var
  130.             fi: FInfo;
  131.             err: OSErr;
  132.     begin
  133.         err := HGetFInfo(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, fi);
  134.         if (err = noErr) & (fi.fdCreator = prefs_creator) & (fi.fdType <> prefs_type) then begin
  135.             fi.fdType := prefs_type;
  136.             fi.fdFlags := BAND(fi.fdFlags, BNOT(fdInited));
  137.             err := HSetFInfo(prefs_fs.vRefNum, prefs_fs.parID, prefs_fs.name, fi);
  138.         end;
  139.     end;
  140.  
  141. {$S Init}
  142.     procedure InitPreferences (strhId, folderindex, fileindex: integer; fcreator: OSType);
  143.         var
  144.             gv: longInt;
  145.             oe: OSErr;
  146.             pb: CInfoPBRec;
  147.             sysenv: SysEnvRec;
  148.             name: str255;
  149.             dummy: longInt;
  150.             our_prefs_folder_vrn: integer;
  151.             our_prefs_folder_dirID: longInt;
  152.     begin
  153.         new(prefs);
  154.         prefs.Create(0, false, true);
  155.         prefs.safeget := true;
  156.         prefs_creator := fcreator;
  157.  
  158. { First Find the Preferences Folder }
  159.         if (Gestalt(gestaltFindFolderAttr, gv) <> noErr) | (not BTST(gv, gestaltFindFolderPresent)) | (FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, the_prefs_folder_vrn, the_prefs_folder_dirID) <> NoErr) then begin
  160.             oe := SysEnvirons(1, sysenv);
  161.             the_prefs_folder_vrn := sysenv.sysVRefNum;
  162.             the_prefs_folder_dirID := 0;
  163.             name := 'Preferences';
  164.             oe := DirCreate(the_prefs_folder_vrn, the_prefs_folder_dirID, name, dummy);
  165.             oe := MyGetCatInfo(the_prefs_folder_vrn, the_prefs_folder_dirID, name, 0, pb);
  166.             if (oe = noErr) & (BAND(pb.ioFlAttrib, $10) <> 0) then begin
  167.                 the_prefs_folder_vrn := pb.ioVRefNum;
  168.                 the_prefs_folder_dirID := pb.ioDirID;
  169.             end;
  170.         end;
  171.  
  172. { Then our folder, if any }
  173.         our_prefs_folder_vrn := the_prefs_folder_vrn;
  174.         our_prefs_folder_dirID := the_prefs_folder_dirID;
  175.         if folderindex > 0 then begin
  176.             GetIndString(name, strhId, folderindex);
  177.             oe := DirCreate(our_prefs_folder_vrn, our_prefs_folder_dirID, name, dummy);
  178.             oe := MyGetCatInfo(our_prefs_folder_vrn, our_prefs_folder_dirID, name, 0, pb);
  179.             if (oe = noErr) & (BAND(pb.ioFlAttrib, $10) <> 0) then begin
  180.                 our_prefs_folder_vrn := pb.ioVRefNum;
  181.                 our_prefs_folder_dirID := pb.ioDirID;
  182.             end;
  183.         end;
  184.  
  185.         GetIndString(name, strhId, fileindex);
  186.         oe := MyFSMakeFSSpec(our_prefs_folder_vrn, our_prefs_folder_dirID, name, prefs_fs);
  187.  
  188.         FixPrefType;
  189.  
  190.         MyGetModDate(prefs_fs, prefs_mdate);
  191.         JustReadPrefsData;
  192.     end;
  193.  
  194. {$S Term}
  195.     procedure FinishPreferences;
  196.     begin
  197.         prefs.Destroy;
  198.     end;
  199.  
  200. end.